home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / elephant.arc / ELEPHANT.BAS < prev   
BASIC Source File  |  1986-04-26  |  5KB  |  137 lines
  1. 10 '╔═════════════════════════════════╗
  2. 11 '║  The  programs in this package  ║
  3. 12 '║  are for   IBM   demonstration  ║
  4. 13 '║  purposes only.                 ║
  5. 14 '║  Questions  about  the  PC  in  ║
  6. 15 '║  education including this demo  ║
  7. 16 '║  package  should  be  directed  ║
  8. 17 '║  to the NMD Education Industry  ║
  9. 18 '║  Response Line.                 ║
  10. 19 '║       Tie line: 331-4620        ║
  11. 20 '║         1-800-241-2002          ║
  12. 21 '║  These programs were developed  ║
  13. 22 '║  and/or modified for this Demo  ║
  14. 23 '║  by Bill Harton, Paul Largent,  ║
  15. 24 '║  and Bob Swartz.                ║
  16. 25 '╚═════════════════════════════════╝
  17. 1000  '"B:ELEPHANT.BAS
  18. 1010 ON KEY(2) GOSUB 2190
  19. 1020 KEY(2) ON
  20. 1030 ON KEY(5) GOSUB 2170
  21. 1040 KEY(5) ON
  22. 1050 ON KEY(6) GOSUB 2180
  23. 1060 KEY(6) ON
  24. 1070 REM check for color monitor
  25. 1080 DEF SEG = 0
  26. 1090 IF (PEEK(&H410) AND &H30) <> &H30       THEN GOTO 1160
  27. 1100 CLS:LOCATE 1,1:PRINT "You are not using a color monitor."
  28. 1110 PRINT
  29. 1120 PRINT "You must use a color monitor to"
  30. 1130 PRINT "see this demonstration."
  31. 1140 PRINT :COLOR 21,0:PRINT "Press any key to continue.":COLOR 7,0
  32. 1150 A$=INPUT$(1):RUN "GRAPH.bas"
  33. 1160 DEFINT A-Z:KEY OFF:SCREEN 1,0:COLOR 0,1:CLS:K=0:MN=0:Z=0
  34. 1170 PRINT:PRINT:PRINT
  35. 1180 PRINT TAB(3) "PLEASE WAIT UNTIL I UNPACK MY TRUNK"
  36. 1190 PRINT:PRINT
  37. 1200 PRINT TAB(14) "L.E. PHANT
  38. 1210 DEF SEG=&HB800
  39. 1220 DIM ARA#(38),ARL#(50),ALA#(88),ALL#(88),BRA#(38),BLL#(88),CRL#(50),CLA#(88)
  40. 1230 DIM AEYE#(4),ATAIL#(13),CEYE#(4),CTAIL#(13)
  41. 1240 DIM A#(825)
  42. 1250 GOSUB 1840
  43. 1260 DIM TFT$(100):GOSUB 1450:PLAY"MF O2;T255;L4"
  44. 1270  CLS:COLOR 0:PUT(90,5),A#
  45. 1280  GET(108,76)-(133,111),ARA#:GET(149,132)-(200,183),ALL#
  46. 1290  GET(114,151)-(157,183),ARL#:GET(124,75)-(184,117),ALA#
  47. 1300  GET(151,38)-(159,44),AEYE#:GET(196,159)-(217,173),ATAIL#
  48. 1310 COLOR 1:LOCATE 1,13:PRINT "Who says you can't";
  49. 1320 LOCATE 25,10:PRINT "make an Elephant dance?";
  50. 1330 XZ=0:I=0:K=0
  51. 1340 IF TFT$(K)="P4" THEN SOUND 1100,1:SOUND 37,0:SOUND 1200,1:SOUND 37,0 :FOR QP=1 TO 200-XZ:NEXT QP:XZ=XZ+10:K=K+1:IF K=MN THEN 1790 ELSE I=(I MOD 8)+1:ON I GOTO 1370,1380,1390,1400,1410,1420,1430,1440
  52. 1350 IF TFT$(K)<>"P4" THEN PLAY TFT$(K):K=K+1:IF K=MN THEN 1790 ELSE I=(I MOD 8)+1:QP=0:ON I GOTO 1370,1380,1390,1400,1410,1420,1430,1440
  53. 1360 BEEP:GOTO 1340
  54. 1370 PUT(149,132),BLL#,PSET:GOTO 1340
  55. 1380 PUT(108,76),BRA#,PSET:GOTO 1340
  56. 1390 PUT(149,132),ALL#,PSET:GOTO 1340
  57. 1400 PUT(108,76),ARA#,PSET:GOTO 1340
  58. 1410 PUT(114,151),CRL#,PSET:GOTO 1340
  59. 1420 PUT(124,75),CLA#,PSET:GOTO 1340
  60. 1430 PUT(114,151),ARL#,PSET:GOTO 1340
  61. 1440 PUT(124,75),ALA#,PSET:IF QP=0 THEN XZ=0:GOTO 1340:ELSE GOTO 1340
  62. 1450 READ TFT$(MN):IF TFT$(MN)<>"" THEN MN=MN+1:GOTO 1450 ELSE RETURN
  63. 1460 DATA "MLF2","MSFD"
  64. 1470 DATA "MLE2","MSED"
  65. 1480 DATA "F7F7F7","MLFMSF9D"
  66. 1490 DATA "MLE2","MNE2"
  67. 1500 DATA "MLE2","MSEC"
  68. 1510 DATA "MLD2","MSDC"
  69. 1520 DATA "E7E7E7","MLEMSE9C"
  70. 1530 DATA "MLD2","MND2"
  71. 1540 DATA "MLF2","MSFD"
  72. 1550 DATA "MLE2","MSED"
  73. 1560 DATA "F7F7F7","MLFMSF9D"
  74. 1570 DATA "MLE2","MNC2","MSA2","P4","P4"
  75. 1580 DATA "P4","P4","P4","P4"
  76. 1590 DATA "P4","P4","P4","P4"
  77. 1600 DATA "P4","P4","P4","P4"
  78. 1610 DATA "P4"
  79. 1620 DATA "MLA2","MSAF#"
  80. 1630 DATA "MLG#2","MSG#F#"
  81. 1640 DATA "A7A7A7","MLAMSA9F#"
  82. 1650 DATA "MLG#2","MNG#2"
  83. 1660 DATA "MLG#2","MSG#E"
  84. 1670 DATA "MLF#2","MSF#E"
  85. 1680 DATA "G#7G#7G#7","MLG#MSG#9E"
  86. 1690 DATA "MLF#2","MNF#2"
  87. 1700 DATA "MLA2","MSAF#"
  88. 1710 DATA "MLG#2","MSG#F#"
  89. 1720 DATA "A7A7A7","MLAMSA9F#"
  90. 1730 DATA "MLG#2","MNE2","MSC#2","P4","P4"
  91. 1740 DATA "P4","P4","P4","P4"
  92. 1750 DATA "P4","P4","P4","P4"
  93. 1760 DATA "P4","P4","P4","P4"
  94. 1770 DATA "P4"
  95. 1780 DATA ""
  96. 1790 PUT(151,38),CEYE#,PSET:Z=0
  97. 1800 FOR K=1 TO  5:PUT(196,159),CTAIL#,PSET:FOR I=1 TO 200:NEXT:PUT(196,159),ATAIL#,PSET:FOR I = 1 TO 200:NEXT:NEXT K :Z=Z+1:ON Z GOTO 1810,1820,1830,2150
  98. 1810 OS=0:EC=1:OC=1:X=180:Y=20:GOTO 1800
  99. 1820 EC=2:OC=2:X=20:Y=100:GOTO 1800
  100. 1830 EC=3:OC=3:X=220:Y=140:GOTO 1800
  101. 1840 '
  102. 1850 EC=2:OC=2:X=40:Y=23:
  103. 1860 X=105:Y=48:
  104. 1870 X=95:Y=73:
  105. 1880 OPEN "ELEPH.DAT" AS #1 LEN=128: DIM E$(15)
  106. 1890 FOR I=0 TO 15:FIELD #1,I*8 AS DUMMY$,8 AS E$(I):NEXT I
  107. 1900 GET #1,1
  108. 1910 EC=0:OC=0:BC=3:X=65:Y=123:
  109. 1920 EC=3:OC=3:BC=4:X=24:Y=150:OS=128:
  110. 1930 FOR I=0 TO 825:A#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
  111. 1940 NEXT I
  112. 1950 FOR I=0 TO 38:BRA#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
  113. 1960 NEXT I
  114. 1970 FOR I=0 TO 88:BLL#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
  115. 1980 NEXT I
  116. 1990 FOR I=0 TO 50:CRL#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
  117. 2000 NEXT I
  118. 2010 FOR I=0 TO 88:CLA#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
  119. 2020 NEXT I
  120. 2030 FOR I=0 TO 4:CEYE#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
  121. 2040 NEXT I
  122. 2050 FOR I=0 TO 13:CTAIL#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
  123. 2060 NEXT I
  124. 2070 CLOSE:RETURN
  125. 2080 'SAVE"GCS",A  'GRAPHICS CHARACTER SUBROUTINES
  126. 2090 'DISPLAY STRING
  127. 2100 '
  128. 2110 'INITIALIZATION
  129. 2120 A=0:X=0:Y=0:LX=0:LY=0:EC=3:OC=3:BC=4:D$="":K=0:WID=320
  130. 2130 DIM CHAR$(255,2),H(255),W(255)
  131. 2140 SH=H:SW=W:H(32)=SH:W(32)=SW:RETURN
  132. 2150 IF QUITER = -1 THEN GOTO 1330
  133. 2160 RUN "graph.bas"
  134. 2170 QUITER = -1 : LOCATE 1,1:PRINT "*":RETURN
  135. 2180 QUITER =  0 : LOCATE 1,1:PRINT " ";:RETURN
  136. 2190 RUN"Graph.BAS":END
  137.